home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / dndlb.exe / TWOWAYLB.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-03-16  |  2.7 KB  |  112 lines
  1. {$D-,L-,Y-,R+}
  2.  
  3. UNIT TwoWayLB;
  4.  
  5. { **********************************************************************
  6.   *
  7.   *  Unit :    TwoWayLb
  8.   *
  9.   *  Author :  Ian Hayes
  10.   *            Soft Systems Ltd,
  11.   *            London,UK
  12.   *            Compuserve id: 100010,1415
  13.   *
  14.   *  Description :
  15.   *
  16.   *            A new listbox type that returns the list of items
  17.   *            in the dialog listbox into the transfer buffer
  18.   *            PStrCollection.
  19.   *
  20.   *            Ordinary listboxes only return the listbox
  21.   *            selection (or multiple selections) as integers.
  22.   *            Those integers are then related to the transfer
  23.   *            buffer PStrCollection setup as part of the
  24.   *            pre dialog transfer buffer mechanism.
  25.   *
  26.   *            This new listbox derivative returns the
  27.   *            full listbox item list by disposing the original
  28.   *            transfer buffer PStrCollection and replacing it with
  29.   *            the strings found in the listbox.
  30.   *
  31.   ********************************************************************* }
  32.  
  33. { :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  34.  
  35. INTERFACE
  36.  
  37. uses
  38.  
  39.    {$IFDEF Ver70}
  40.       Objects,
  41.       OWindows,
  42.       ODialogs,
  43.    {$ELSE}
  44.       WObjects,
  45.    {$ENDIF}
  46.    WinTypes,
  47.    WinProcs,
  48.    Strings;
  49.  
  50. { :::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  51.  
  52. TYPE
  53.  
  54.    PTwoWayListBox = ^TTwoWayListBox;
  55.  
  56.    TTwoWayListBox = OBJECT(TListBox)
  57.       FUNCTION Transfer(DataPtr: POINTER;
  58.                         TransferFlag: WORD): WORD; VIRTUAL;
  59.    END;
  60.  
  61.  
  62. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  63.  
  64. IMPLEMENTATION
  65.  
  66. { ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  67.  
  68. FUNCTION TTwoWayListBox.Transfer(DataPtr: POINTER;
  69.                                  TransferFlag: WORD): WORD;
  70. VAR
  71.    TotNo,Idx: INTEGER;
  72.    W : WORD;
  73.    AStr : ARRAY[0..200] OF CHAR;
  74.    AStrColl : PStrCollection;
  75.  
  76.    { +++++++++++++++++++++++++++ }
  77.  
  78.    PROCEDURE ZapStr(AStr: PChar); FAR;
  79.    BEGIN
  80.       StrDispose(AStr);
  81.    END;
  82.  
  83.    { +++++++++++++++++++++++++++ }
  84.  
  85. BEGIN
  86.    IF TransferFlag <> tf_GetData THEN
  87.       W := TListBox.Transfer(DataPtr,TransferFlag)
  88.    ELSE
  89.    BEGIN
  90.       AStrColl := PStrCollection(DataPtr^);
  91.       AStrColl^.ForEach(@ZapStr);
  92.       AStrColl^.DeleteAll;
  93.       TotNo := GetCount;
  94.       FOR Idx := 0 TO (TotNo-1) DO
  95.       BEGIN
  96.          GetString(AStr,Idx);
  97.          AStrColl^.AtInsert(Idx,StrNew(AStr));
  98.       END;
  99.       IF (GetWindowLong(HWindow,gwl_Style) AND lbs_MultipleSel) <> 0 THEN
  100.          W := 8
  101.       ELSE
  102.          W := 6;
  103.    END;
  104.    Transfer := W;
  105. END;
  106.  
  107.  
  108. { :::::::::::::::::::::::::::::::::::::::::::::::::::::: }
  109.  
  110. BEGIN
  111.  
  112. END.